home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
hailpath.rpl
< prev
next >
Wrap
Text File
|
1991-02-21
|
2KB
|
49 lines
HailPath
By Joseph K. Horn
Returns the Syracuse Algorithm "hailstone path distance" between X and 1.
D9D20 @ :: (Begin RPL) ; 02D9D Program object prolog (backwards!)
E1632 @ \<< ; 2361E Open program delimiters.
B9691 @ R->B ; 1969B Hex for double precision.
CCD20 @ In-line code ; 02DCC Code object prolog.
F6000 @ Code length = 111 ; 0006F (Nib count includes itself.)
AF9 @ C=B W ; Save B
10A @ R2=C ; in R2,
137 @ CD1EX ; and save D1 (user stack pointer)
109 @ R1=C ; in R1.
137 @ CD1EX ; Get address
147 @ C=DAT1 A ; of level 1, and
137 @ CD1EX ; point to it.
179 @ D1=D1+ 10 ; Skip over object header to the contents.
1537 @ A=DAT1 W ; Get level 1 argument (in hex) into A.
822 @ SB=0 ; Clear Sticky Bit, used for even/odd test.
AF1 @ B=0 W ; Clear the Loop Counter (B).
AF3 @ D=0 W ; The exit test needs a 1; make D=1 by
B67 @ D=D+1 B ; clearing D and adding 1 to it.
AF6 @ L1 C=A W ; A,C hold the hailstone number en route to 1.
9FB @ ?C<=D W ; Has the hailstone hit ground yet? (is C<=1?)
F1 @ GOYES L3 ; If so, exit; else,
B75 @ L2 B=B+1 W ; increment the Loop Counter.
81C @ ASRB ; A=IP(A/2), and lost bit -> Sticky Bit.
832 @ ?SB=0 ; Was the hailstone number even?
FE @ GOYES L1 ; If so, simply repeat; else,
A72 @ C=C+A W ; Multiply by 3, add 1, and divide by 2,
B76 @ C=C+1 W ; using shortcut A+IP(A/2)+1.
B75 @ B=B+1 W ; Increment Loop Counter again due to shortcut.
AFA @ A=C W ; Get ready for
822 @ SB=0 ; the next test, and
55E @ GONC L2 ; go try again (Branch Every Time).
AF9 @ L3 C=B W ; Replace level 1 argument
1557 @ DAT1=C W ; with Loop Counter = HAILPATH(x).
119 @ C=R1 ; Restore User Stack Pointer (D1)
137 @ CD1EX ; from R1,
11A @ C=R2 ; and restore B
AF5 @ B=C W ; from R2.
142 @ A=DAT0 A ; End \
164 @ D0=D0+ 5 ; of > Code always ends like this.
808C @ PC=(A) ; Code. /
BB691 @ B->R ; 196BB Back to normal (decimal).
93632 @ \>> ; 23639
B2130 @ ; (End of RPL.) ; 0312B